home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Applications / NIH Image 1.62b11 / src / fft.p < prev    next >
Text File  |  1996-06-10  |  19KB  |  809 lines

  1. unit fft;
  2.  
  3. {
  4. This file contains a Pascal language implementation of the 
  5. Fast Hartley Transform algorithm which is covered under
  6. United States Patent Number 4,646,256.
  7.  
  8. This code may therefore be freely used and distributed only
  9. under the following conditions:
  10.  
  11.         1)  This header is included in every copy of the code; and
  12.         2)  The code is used for noncommercial research purposes only.
  13.  
  14.  Firms using this code for commercial purposes will be infringing a United
  15.  States patent and should contact the
  16.  
  17.                     Office of Technology Licensing
  18.                     Stanford University
  19.                     857 Serra Street, 2nd Floor
  20.                     Stanford, CA   94305-6225
  21.                     (415) 723 0651
  22.  
  23. This implementation is based on Pascal code contibuted
  24. by Arlo Reeves (arlo@apple.com).
  25. }
  26.  
  27. interface
  28.     uses
  29.         Types, Memory, QuickDraw, QuickDrawText, Packages, Menus, Events, Fonts, 
  30.         Scrap, ToolUtils, Resources, Errors, Palettes, StandardFile, Windows,
  31.         Controls, TextEdit, Files, Dialogs, TextUtils, Finder, MixedMode, Processes,
  32.         globals, Utilities, Graphics, Filters, Analysis;
  33.  
  34.     procedure doFFT(fftKind: fftType);
  35.     procedure DisplayPowerSpectrum(x: rImagePtr);
  36.     function   isPowerOf2 (x: LongInt): boolean;
  37.     procedure SetFFTWindowName(doInverse: boolean);
  38.     procedure RedisplayPowerSpectrum;
  39.     procedure doSwapQuadrants;
  40.     function isFFT: boolean;
  41.     procedure ShowFFTValues (hloc, vloc, ivalue: LongInt);
  42.  
  43.  
  44. implementation
  45.  
  46.     const
  47.         UpdateTicks = 10; {Show progress 6 times/sec}
  48.         
  49.     var
  50.         AbortFFT: boolean;
  51.         C, S: rLinePtr;
  52.  
  53.  
  54.     function log2 (x: LongInt): LongInt;
  55.         var
  56.             count: LongInt;
  57.     begin
  58.         count := 15;
  59.         while not BTST(x, count) do
  60.             count := count - 1;
  61.         log2 := count;
  62.     end;
  63.     
  64.  
  65.     function BitRevX (x, bitlen: LongInt): LongInt;
  66.         var
  67.             i: LongInt;
  68.             temp: longint;
  69.     begin
  70.         temp := 0;
  71.         for i := 0 to bitlen do
  72.             if BTST(x, i) then
  73.                 BSET(temp, bitlen - i - 1);
  74.         BitRevX := LoWord(temp);
  75.     end;
  76.     
  77.  
  78.     procedure BitRevRArr (x: rLinePtr; bitlen, maxN: LongInt);
  79.         var
  80.             i: LongInt;
  81.             tempArr: rLineType;
  82.     begin
  83.         for i := 0 to maxN - 1 do
  84.             tempArr[i] := x^[BitRevX(i, bitlen)];
  85.         BlockMove(@tempArr, x, maxN * SizeOf(real));
  86.     end;
  87.     
  88.  
  89.     procedure transposeR (x: rImagePtr; maxN: LongInt);
  90.         var
  91.             r, c: LongInt;
  92.             rTemp: real;
  93.     begin
  94.         for r := 0 to maxN - 1 do
  95.             for c := r to maxN - 1 do
  96.                 if r <> c then
  97.                     begin
  98.                         rTemp := x^[ r * maxN + c];
  99.                         x^[ r * maxN + c] := x^[c * maxN + r];
  100.                         x^[c * maxN + r] := rTemp;
  101.                     end;
  102.     end;
  103.     
  104.  
  105.     procedure FHTps (r, maxN: LongInt; inMat: rImagePtr;  var outArr: rLineType);
  106. { Power Spectrum of one row from 2D Hartley Transform }
  107.         var
  108.             c, base: LongInt;
  109.     begin
  110.         base := r * maxN;
  111.         for c := 0 to maxN - 1 do
  112.             outArr[c] := (sqr(inMat^[base + c]) + sqr(inMat^[((maxN - r) mod maxN) * maxN + (maxN - c) mod maxN])) / 2;
  113.     end;
  114.  
  115.  
  116.     procedure dfht3 (x: rLinePtr; inverse: boolean; maxN: LongInt);
  117.     { an optimized real FHT }
  118.         var
  119.             i, stage, gpNum, gpIndex, gpSize, numGps, Nlog2: LongInt;
  120.             bfNum, numBfs: LongInt;
  121.             Ad0, Ad1, Ad2, Ad3, Ad4, CSAd: LongInt;
  122.             rt1, rt2, rt3, rt4: real;
  123.     begin
  124.         Nlog2 := log2(maxN);
  125.         BitRevRArr(x, Nlog2, maxN);            { bitReverse the input array }
  126.  
  127.         gpSize := 2;                        { first & second stages - do radix 4 butterflies once thru }
  128.         numGps := maxN div 4;
  129.         for gpNum := 0 to numGps - 1 do
  130.             begin
  131.                 Ad1 := gpNum * 4;
  132.                 Ad2 := Ad1 + 1;
  133.                 Ad3 := Ad1 + gpSize;
  134.                 Ad4 := Ad2 + gpSize;
  135.                 rt1 := x^[Ad1] + x^[Ad2];            { a + b }
  136.                 rt2 := x^[Ad1] - x^[Ad2];            { a - b }
  137.                 rt3 := x^[Ad3] + x^[Ad4];            { c + d }
  138.                 rt4 := x^[Ad3] - x^[Ad4];            { c - d }
  139.                 x^[Ad1] := rt1 + rt3;                { a + b + (c + d ) }
  140.                 x^[Ad2] := rt2 + rt4;                { a - b + (c - d ) }
  141.                 x^[Ad3] := rt1 - rt3;                { a + b - (c + d ) }
  142.                 x^[Ad4] := rt2 - rt4;                { a - b - (c - d ) }
  143.             end;
  144.  
  145.         if Nlog2 > 2 then
  146.             begin                        { third + stages computed here }
  147.                 gpSize := 4;
  148.                 numBfs := 2;
  149.                 numGps := numGps div 2;
  150.                 for stage := 2 to Nlog2 - 1 do
  151.                     begin
  152.                         for gpNum := 0 to numGps - 1 do
  153.                             begin
  154.                                 Ad0 := gpNum * gpSize * 2;
  155.                                 Ad1 := Ad0;                            { 1st butterfly is different from others - no mults needed }
  156.                                 Ad2 := Ad1 + gpSize;
  157.                                 Ad3 := Ad1 + gpSize div 2;
  158.                                 Ad4 := Ad3 + gpSize;
  159.                                 rt1 := x^[Ad1];
  160.                                 x^[Ad1] := x^[Ad1] + x^[Ad2];
  161.                                 x^[Ad2] := rt1 - x^[Ad2];
  162.                                 rt1 := x^[Ad3];
  163.                                 x^[Ad3] := x^[Ad3] + x^[Ad4];
  164.                                 x^[Ad4] := rt1 - x^[Ad4];
  165.                                 for bfNum := 1 to numBfs - 1 do
  166.                                     begin        { subsequent BF's dealt with together }
  167.                                         Ad1 := bfNum + Ad0;
  168.                                         Ad2 := Ad1 + gpSize;
  169.                                         Ad3 := gpSize - bfNum + Ad0;
  170.                                         Ad4 := Ad3 + gpSize;
  171.  
  172.                                         CSAd := bfNum * numGps;
  173.                                         rt1 := x^[Ad2] * C^[CSAd] + x^[Ad4] * S^[CSAd];
  174.                                         rt2 := x^[Ad4] * C^[CSAd] - x^[Ad2] * S^[CSAd];
  175.  
  176.                                         x^[Ad2] := x^[Ad1] - rt1;
  177.                                         x^[Ad1] := x^[Ad1] + rt1;
  178.                                         x^[Ad4] := x^[Ad3] + rt2;
  179.                                         x^[Ad3] := x^[Ad3] - rt2;
  180.  
  181.                                     end;         { for bfNum := 0 to ... }
  182.                             end;            { for gpNum := 0 to ... }
  183.                         gpSize := gpSize * 2;
  184.                         numBfs := numBfs * 2;
  185.                         numGps := numGps div 2;
  186.                     end;
  187.             end;        { if }
  188.  
  189.         if inverse then
  190.             for i := 0 to maxN - 1 do
  191.                 x^[i] := x^[i] / maxN;
  192.     end;
  193.  
  194.  
  195.     procedure rc2Dfht (x: rImagePtr; inverse: boolean; maxN: LongInt);
  196. { Row-column 2D FHT }
  197.         var
  198.             row, col, mRow, mCol, NextTicks: LongInt;
  199.             A, B, C, D, E: real;
  200.             theRow: rLinePtr;
  201.     begin
  202.         NextTicks := TickCount + UpdateTicks;
  203.         for row := 0 to maxN - 1 do begin
  204.             theRow := rLinePtr(ord4(x) + row * maxN * SizeOf(real));
  205.             dfht3(theRow, inverse, maxN);
  206.             if TickCount > nextTicks then begin
  207.                 UpdateMeter(round(row/maxN * 50.0), 'Computing FHT');
  208.                 nextTicks := TickCount + updateTicks;
  209.                 if CommandPeriod then begin
  210.                         beep;
  211.                         AbortFFT := true;
  212.                         exit(rc2Dfht)
  213.                     end;
  214.             end;
  215.         end;
  216.         transposeR(x, maxN);
  217.         for row := 0 to maxN - 1 do begin
  218.             theRow := rLinePtr(ord4(x) + row * maxN * SizeOf(real));
  219.             dfht3(theRow, inverse, maxN);
  220.             if TickCount > nextTicks then begin
  221.                 UpdateMeter(round(row/maxN * 50.0) + 50, 'Computing FHT');
  222.                 nextTicks := TickCount + updateTicks;
  223.                 if CommandPeriod then begin
  224.                         beep;
  225.                         AbortFFT := true;
  226.                         exit(rc2Dfht)
  227.                     end;
  228.             end;
  229.         end;
  230.         transposeR(x, maxN);
  231.         for row := 0 to maxN div 2 do             { Now calculate actual Hartley transform }
  232.             for col := 0 to maxN div 2 do
  233.                 begin
  234.                     mRow := (maxN - row) mod maxN;
  235.                     mCol := (maxN - col) mod maxN;
  236.                     A := x^[row * maxN + col];                        { see Bracewell, 'Fast 2D Hartley Transf.' IEEE Procs. 9/86 }
  237.                     B := x^[mRow * maxN + col];
  238.                     C := x^[row * maxN + mCol];
  239.                     D := x^[mRow * maxN + mCol];
  240.                     E := ((A + D) - (B + C)) / 2;
  241.                     x^[row * maxN + col] := A - E;
  242.                     x^[mRow * maxN + col] := B + E;
  243.                     x^[row * maxN + mCol] := C + E;
  244.                     x^[mRow * maxN + mCol] := D - E;
  245.                 end;
  246.         UpdateMeter(-1, 'Hide Meter');
  247.     end;
  248.     
  249.     
  250. procedure SwapQuadrants;
  251. {Swap quadrants 1 and 3 and quadrants 2 and 4 so the}
  252. {power spectrum origin is at the center of the image.}
  253. {2 1}
  254. {3 4}
  255. var
  256.     row, col, halfMaxN, tmp, maxN: LongInt;
  257.     line1, line2: LineType;
  258. begin
  259.     maxN := info^.PixelsPerLine;
  260.     halfMaxN := maxN div 2;
  261.     for row:= 0 to halfMaxN -1 do begin
  262.         GetLine(0, row, maxN, line1);
  263.         GetLine(0, row + halfMaxN, maxN, line2);
  264.         for col := 0 to halfMaxN -1 do begin
  265.             tmp := line1[col];
  266.             line1[col] := line1[col + halfMaxN];
  267.             line1[col + halfMaxN] := tmp;
  268.             tmp := line2[col];
  269.             line2[col] := line2[col + halfMaxN];
  270.             line2[col + halfMaxN] := tmp;
  271.         end;
  272.         PutLine(0, row, maxN, line2);
  273.         PutLine(0, row + halfMaxN, maxN, line1);
  274.     end;
  275. end;
  276.  
  277.  
  278.     
  279.     procedure DisplayRealImage(x: rImagePtr);
  280.         var
  281.             row, col, i, base, maxN: LongInt;
  282.             r, min, max, scale: real;
  283.             line: lineType;
  284.     begin
  285.         maxN := info^.PixelsPerLine;
  286.         min := 1e99;
  287.         max := -1e99;
  288.         i := 1;
  289.         for row := 0 to maxN - 1 do begin
  290.             base := row * maxN;
  291.             for col := 0 to maxN - 1 do begin
  292.                     r := x^[base + col];
  293.                     if r < min then min := r;
  294.                     if r > max then max := r;
  295.             end;
  296.         end;
  297.         scale := 253.0 / (max - min);
  298.         for row := 0 to maxN - 1 do begin
  299.                 base := row * maxN;
  300.                 for col := 0 to maxN - 1 do begin
  301.                         r := x^[base + col];
  302.                         line[col] := round((r - min) * scale) + 1;
  303.                 end;
  304.                 PutLine(0, row, maxN, line);
  305.             end;
  306.     end;
  307.  
  308.  
  309.     procedure DisplayPSUsingBuffer(fht, ps: rImagePtr; var rLine: rLineType);
  310.     var
  311.         row, col, base, nextTicks, maxN: LongInt;
  312.         r, min, max, scale: real;
  313.         line: lineType;
  314.         
  315.     begin
  316.         maxN := info^.PixelsPerLine;
  317.         nextTicks := TickCount + updateTicks;
  318.         min := 1e99;
  319.         max := -1e99;
  320.         for row := 0 to maxN - 1 do begin
  321.             FHTps (row, maxN, fht, rLine);
  322.             base := row * maxN;
  323.             for col := 0 to maxN - 1 do begin
  324.                     r := rLine[col];
  325.                     if r < min then min := r;
  326.                     if r > max then max := r;
  327.                     ps^[base + col] := r;
  328.             end;
  329.             if TickCount > nextTicks then begin
  330.                 UpdateMeter(round(row/maxN * 80.0), 'Computing Power Spectrum');
  331.                 nextTicks := TickCount + updateTicks;
  332.                 if CommandPeriod then begin
  333.                         beep;
  334.                         AbortFFT := true;
  335.                         exit(DisplayPSUsingBuffer)
  336.                     end;
  337.             end;
  338.         end;
  339.         if min < 1.0 then
  340.             min := 0.0
  341.         else
  342.             min := ln(min);
  343.         max := ln(max);
  344.         scale := 253.0 / (max - min);
  345.         for row := 0 to maxN - 1 do begin
  346.                 base := row * maxN;
  347.                 for col := 0 to maxN - 1 do begin
  348.                         r := ps^[base + col];
  349.                         if r < 1.0 then
  350.                             r := 0.0
  351.                         else
  352.                             r := ln(r);
  353.                         line[col] := round((r - min) * scale) + 1;
  354.                 end;
  355.                 PutLine(0, row, maxN, line);
  356.                 if TickCount > nextTicks then begin
  357.                     UpdateMeter(round(row/maxN * 20.0 ) + 80, 'Computing Power Spectrum');
  358.                     nextTicks := TickCount + updateTicks;
  359.                     if CommandPeriod then begin
  360.                             beep;
  361.                             AbortFFT := true;
  362.                             exit(DisplayPSUsingBuffer)
  363.                         end;
  364.                 end;
  365.             end;
  366.         SwapQuadrants;
  367.         UpdateMeter(-1, 'Hide Meter');
  368.     end;    
  369.     
  370.     
  371.     procedure DisplayPowerSpectrum(fht: rImagePtr);
  372.     var
  373.         row, col, nextTicks, maxN: LongInt;
  374.         r, min, max, scale: real;
  375.         line: lineType;
  376.         rLine: rLineType;
  377.         tempH: handle;
  378.         ps: rImagePtr;
  379.     begin
  380.         maxN := info^.PixelsPerLine;
  381.         tempH := GetBigHandle(maxN * maxN * SizeOf(real));
  382.         if tempH <> nil then begin
  383.             hlock(tempH);
  384.             ps := rImagePtr(tempH^);
  385.             DisplayPSUsingBuffer(fht, ps, rLine);
  386.             hunlock(tempH);
  387.             DisposeHandle(tempH);
  388.             exit(DisplayPowerSpectrum);
  389.         end;
  390.         min := 1e99;
  391.         max := -1e99;
  392.         nextTicks := TickCount + updateTicks;
  393.         for row := 0 to maxN - 1 do begin
  394.             FHTps (row, maxN, fht, rLine);
  395.             for col := 0 to maxN - 1 do begin
  396.                     r := rLine[col];
  397.                     if r < min then min := r;
  398.                     if r > max then max := r;
  399.             end;
  400.             if TickCount > nextTicks then begin
  401.                 UpdateMeter(round(row/maxN * 35.0), 'Computing Power Spectrum');
  402.                 nextTicks := TickCount + updateTicks;
  403.                 if CommandPeriod then begin
  404.                         beep;
  405.                         AbortFFT := true;
  406.                         exit(DisplayPowerSpectrum)
  407.                     end;
  408.             end;
  409.         end;
  410.         if min < 1.0 then
  411.             min := 0.0
  412.         else
  413.             min := ln(min);
  414.         max := ln(max);
  415.         scale := 253.0 / (max - min);
  416.         for row := 0 to maxN - 1 do begin
  417.                 FHTps (row, maxN, fht, rLine);
  418.                 for col := 0 to maxN - 1 do begin
  419.                         r := rLine[col];
  420.                         if r < 1.0 then
  421.                             r := 0.0
  422.                         else
  423.                             r := ln(r);
  424.                         line[col] := round((r - min) * scale) + 1;
  425.                 end;
  426.                 PutLine(0, row, maxN, line);
  427.                 if TickCount > nextTicks then begin
  428.                     UpdateMeter(round(row/maxN * 65.0 ) + 35, 'Computing Power Spectrum');
  429.                     nextTicks := TickCount + updateTicks;
  430.                     if CommandPeriod then begin
  431.                             beep;
  432.                             AbortFFT := true;
  433.                             exit(DisplayPowerSpectrum)
  434.                         end;
  435.                 end;
  436.             end;
  437.         SwapQuadrants;
  438.         UpdateMeter(-1, 'Hide Meter');
  439.     end;
  440.  
  441.  
  442. procedure ConvertToReal;
  443. var
  444.     row, col, i, sum, base: LongInt;
  445.     width, height: LongInt;
  446.     mean, pixelCount: real;
  447.     line: LineType;
  448.     DataP: rImagePtr;
  449. begin
  450.     with info^ do begin
  451.         width := pixelsPerLine;
  452.         height := nLines;
  453.         hlock(DataH);
  454.         DataP := rImagePtr(DataH^);
  455.     end;
  456.     UpdateMeter(0, 'Converting to Real');
  457.     {
  458.     GetRectHistogram;
  459.     sum := 0;
  460.     pixelCount := width * height;
  461.     for i := 0 to 255 do
  462.         sum := sum + histogram[i] * i;
  463.     mean := sum / pixelCount;
  464.     }
  465.     for row:= 0 to height - 1 do begin
  466.         GetLine(0, row, width, line);
  467.         base := row * width;
  468.         for col := 0 to width - 1 do
  469.             DataP^[base + col] := line[col] {- mean};
  470.     end;
  471.     hunlock(info^.DataH);
  472. end;
  473.  
  474.  
  475. function isPowerOf2 (x: LongInt): boolean;
  476. var
  477.     i, sum: integer;
  478. begin
  479. sum := 0;
  480. x := abs(x);
  481. for i := 0 to 15 do
  482.     sum := sum + ord(BTST(x, i));
  483. IsPowerOf2 := (sum <= 1);
  484. end;
  485.  
  486.  
  487. function PowerOf2Size: boolean;
  488. var
  489.     width, height: LongInt;
  490.  
  491.     procedure fail;
  492.     begin
  493.          PutError('A square, power of two size image or selection (128x128, 256x256, etc.) required.');
  494.          AbortMacro;
  495.          PowerOf2Size := false;
  496.          exit(PowerOf2Size);
  497.     end;
  498.  
  499. begin
  500.     with info^ do begin
  501.         if info = noInfo then
  502.             fail;
  503.         width := pixelsPerLine;
  504.         height := nLines;
  505.         if RoiShowing and (roiType = rectRoi) then with roiRect do begin
  506.             width := right - left;
  507.             height := bottom - top;
  508.         end;
  509.         if not isPowerOf2(width) or (width <> height) then
  510.             fail;
  511.         if width < 4 then begin
  512.                 PutMessage('Sequence Length must be >= 4.');
  513.                 PowerOf2Size := true;
  514.                 exit(PowerOf2Size);
  515.             end;
  516.         PowerOf2Size := true;
  517.     end;
  518. end;
  519.  
  520.  
  521. function MakeSinCosTables(maxN: LongInt): boolean;
  522. var
  523.     i: LongInt;
  524.     theta, dTheta: real;
  525. begin
  526.     C := rLinePtr(NewPtr(SizeOf(rLineType)));
  527.     S := rLinePtr(NewPtr(SizeOf(rLineType)));
  528.     if (C = nil) or (S = nil) then begin
  529.         MakeSinCosTables := false;
  530.         PutError('Out of Memory');
  531.         exit(MakeSinCosTables);
  532.     end;
  533.     theta := 0;
  534.     dTheta := 2 * pi / maxN;
  535.     for i := 0 to maxN div 4 - 1 do
  536.         begin
  537.             C^[i] := cos(theta);
  538.             S^[i] := sin(theta);
  539.             theta := theta + dTheta;
  540.         end;
  541.         MakeSinCosTables := true;
  542. end;
  543.  
  544.  
  545. function MakeRealImage: boolean;
  546. var
  547.     TempH: handle;
  548.     maxN: LongInt;
  549. begin
  550.     maxN := info^.PixelsPerLine;
  551.     tempH := GetBigHandle(maxN * maxN * SizeOf(real));
  552.     if TempH = nil then begin
  553.         PutMemoryAlert;
  554.         MakeRealImage := false;
  555.         exit(MakeRealImage);
  556.     end;
  557.     if not Duplicate(StringOf('FFT ', nPics + 1:1), false) then begin
  558.         DisposeHandle(TempH);
  559.         exit(MakeRealImage);
  560.     end;
  561.     UpdatePicWindow;
  562.     info^.DataH := tempH;
  563.     ConvertToReal;
  564.     UpdateTitleBar;
  565.     MakeRealImage := true;
  566. end;
  567.  
  568.  
  569. procedure SetFFTWindowName(doInverse: boolean);
  570. begin
  571.     with info^ do begin
  572.         if doInverse then
  573.             title := StringOf('Inverse FFT ', picNum:1)
  574.         else
  575.             title := StringOf('FFT ', picNum:1);
  576.         UpdateWindowsMenuItem;
  577.         UpdateTitleBar;
  578.     end;
  579. end;
  580.  
  581.  
  582. procedure ApplyFilter(rData: rImagePtr);
  583. var
  584.     row, col, width, height, base, i: LongInt;
  585.     line: LineType;
  586.     passMode: boolean;
  587.     t:FateTable;
  588. begin
  589.     SwapQuadrants;
  590.     with info^ do begin
  591.         width := pixelsPerLine;
  592.         height := nLines;
  593.     end;
  594.     for row:= 0 to height - 1 do begin
  595.         GetLine(0, row, width, line);
  596.         base := row * width;
  597.         for col := 0 to width - 1 do
  598.             rData^[base + col] := line[col]/255.0 * rData^[base + col];
  599.     end;
  600. end;
  601.  
  602.  
  603. procedure doMasking(rData: rImagePtr);
  604. var
  605.     row, col, width, height, base, i: LongInt;
  606.     line: LineType;
  607.     passMode: boolean;
  608.     t:FateTable;
  609. begin
  610.     GetRectHistogram;
  611.     if (histogram[0] = 0) and (histogram[255] = 0) then
  612.         exit(doMasking);
  613.     UpdateMeter(0, 'Masking');
  614.     passMode := histogram[255] <> 0;
  615.     if passMode then
  616.         ChangeValues(0,254,0)
  617.     else
  618.         ChangeValues(1,255,255);
  619.     for i := 1 to 3 do
  620.         Filter(UnweightedAvg, 0, t);
  621.     UpdatePicWindow;
  622.     ApplyFilter(rData);
  623. end;
  624.  
  625.  
  626.     procedure doFFT(fftKind: fftType);
  627.     var
  628.         startTicks, maxN: LongInt;
  629.         trect: rect;
  630.         RealData: rImagePtr;
  631.         doInverse: boolean;
  632.     begin
  633.             doInverse := fftKind <> ForewardFFT;
  634.             if not PowerOf2Size then
  635.                 exit(doFFT);
  636.             startTicks := tickCount;
  637.             if info^.DataH = nil then begin
  638.                 if doInverse then begin
  639.                     PutError('A real image is required to do an inverse transform.');
  640.                      AbortMacro;
  641.                     exit(doFFT);
  642.                 end;
  643.                 if not MakeRealImage then begin
  644.                      AbortMacro;
  645.                     exit(doFFT);
  646.                 end
  647.             end else begin
  648.                 KillRoi;
  649.                 SetFFTWindowName(doInverse);
  650.             end;
  651.             hlock(info^.DataH);
  652.             RealData := rImagePtr(info^.DataH^);
  653.             ShowWatch;
  654.             maxN := info^.PixelsPerLine;
  655.             if not MakeSinCosTables(maxN) then
  656.                 exit(doFFT);
  657.             AbortFFT := false;
  658.             ShowMessage(CmdPeriodToStop);
  659.             if doInverse then begin
  660.                 if fftKind = InverseFFTWithMask then 
  661.                     doMasking(RealData)
  662.                 else if fftKind = InverseFFTWithFilter then
  663.                     ApplyFilter(RealData);
  664.                 rc2DFHT(RealData, true, maxN);
  665.                 if not AbortFFT then
  666.                     DisplayRealImage(RealData);
  667.             end else begin
  668.                 rc2DFHT(RealData, false, maxN);
  669.                 if not AbortFFT then
  670.                     DisplayPowerSpectrum(RealData);
  671.             end;
  672.             if AbortFFT then
  673.                 UpdateMeter(-1, 'Hide');
  674.             hunlock(info^.dataH);
  675.             UpdatePicWindow;
  676.             SetRect(trect, 0, 0, maxN, maxN);
  677.             ShowTime(startTicks, trect, '');
  678.             UpdateWindowsMenuItem;
  679.             DisposePtr(ptr(C));
  680.             DisposePtr(ptr(S));
  681.     end;
  682.     
  683.  
  684. function isFFT: boolean;
  685. begin
  686.     isFFT := false;
  687.     with info^ do
  688.         if DataH <> nil then
  689.             if pos('FFT', title) = 1 then
  690.                 isFFT := true;
  691. end;
  692.  
  693.  
  694. procedure RedisplayPowerSpectrum;
  695.     var
  696.         rData: rImagePtr;
  697.     begin
  698.             if info = noInfo then
  699.                 exit(RedisplayPowerSpectrum);
  700.             KillRoi;
  701.             if not PowerOf2Size then
  702.                 exit(RedisplayPowerSpectrum);
  703.             if not isFFT then begin
  704.                     PutError('Real frequency domain image required.');
  705.                     exit(RedisplayPowerSpectrum);
  706.                 end;
  707.             hlock(info^.DataH);
  708.             rData := rImagePtr(info^.DataH^);
  709.             DisplayPowerSpectrum(rData);
  710.             hunlock(info^.dataH);
  711.             UpdatePicWindow;
  712.     end;
  713.  
  714.  
  715.     Procedure doSwapQuadrants;
  716.     begin
  717.         if info = noInfo then
  718.             exit(doSwapQuadrants);
  719.         KillRoi;
  720.         if not PowerOf2Size then
  721.             exit(doSwapQuadrants);
  722.         SetupUndo;
  723.         WhatToUndo := UndoEdit;
  724.         SwapQuadrants;
  725.         UpdatePicWindow;
  726.     end;
  727.     
  728.     
  729.     function arctan2 (x, y: extended): extended;
  730. { returns angle in the correct quadrant }
  731.     begin
  732.         if x = 0 then
  733.             x := 1E-30; { Could be improved }
  734.         if x > 0 then
  735.             if y >= 0 then
  736.                 arctan2 := arctan(y / x)
  737.             else
  738.                 arctan2 := arctan(y / x) + 2 * pi
  739.         else
  740.             arctan2 := arctan(y / x) + pi;
  741.     end;
  742.     
  743.  
  744.     procedure ShowFFTValues (hloc, vloc, ivalue: LongInt);
  745.         var
  746.             tPort: GrafPtr;
  747.             hstart, vstart: integer;
  748.             r, theta, center: extended;
  749.     begin
  750.         with info^ do
  751.             begin
  752.                 hstart := InfoHStart;
  753.                 vstart := InfoVStart;
  754.                 GetPort(tPort);
  755.                 SetPort(InfoWindow);
  756.                 TextSize(9);
  757.                 TextFont(Monaco);
  758.                 TextMode(SrcCopy);
  759.                 if hloc < 0 then
  760.                     hloc := -hloc;
  761.                 center := pixelsPerLine div 2;
  762.                 r := sqrt(sqr(hloc - center) + sqr(vloc - center));
  763.                 theta := arctan2(hloc - center, center - vloc);
  764.                 theta := theta * 180 / pi;
  765.                 MoveTo(xValueLoc, vstart);
  766.                 if SpatiallyCalibrated then begin
  767.                         DrawReal(pixelsPerLine / r / xScale, 6, 2);
  768.                         DrawString(xUnit);
  769.                         DrawString('/c ');
  770.                         DrawString('(');
  771.                         DrawReal(hloc - center, 4, 0);
  772.                         DrawString(')');
  773.                     end else begin
  774.                         DrawReal(pixelsPerLine / r, 6, 2);
  775.                         DrawString('p/c  ');
  776.                         DrawString('(');
  777.                         DrawReal(hloc - center, 4, 0);
  778.                         DrawString(')');
  779.                     end;
  780.                 DrawString('    ');
  781.                 vloc := PicRect.bottom - vloc - 1;
  782.                 if vloc < 0 then
  783.                     vloc := -vloc;
  784.                 MoveTo(yValueLoc, vstart + 10);
  785.                 DrawReal(theta, 6, 2);
  786.                 TextMode(srcOr);
  787.                 DrawString('°    ');
  788.                 TextMode(srcCopy);
  789.                 DrawString('(');
  790.                 DrawReal(vloc - center + 1, 4, 0);
  791.                 DrawString(')');
  792.                 DrawString('    ');
  793.                 MoveTo(zValueLoc, vstart + 20);
  794.                 if fit <> uncalibrated then
  795.                     begin
  796.                         DrawReal(cvalue[ivalue], 6, 2);
  797.                         DrawString(' (');
  798.                         DrawLong(ivalue);
  799.                         DrawString(')');
  800.                     end
  801.                 else
  802.                     DrawLong(ivalue);
  803.                 DrawString('    ');
  804.                 SetPort(tPort);
  805.             end;
  806.     end;
  807.  
  808.  
  809. end. {fft Unit}